perm filename SC2XA[1,LCS] blob
sn#607336 filedate 1981-08-19 generic text, type T, neo UTF8
SUBROUTINE READIT
COMMON /PCIP/ PCH(27,102),IPT(27,101) /ERRFLG/ERRFLG
COMMON/P/P(1) /PL/PL(1) /COPY/NUMP /NUMPAR/NUMPAR(27)
COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,TPALN(4),JED /NAMES/NA(100),LETRS(27),JNAM(27)
CC 1 LN,ITYP,TPALN(4),JED /IFI/IFI
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
COMMON /VV/LIMIT,V(1) /A/ROFF(27),NP(27)
1,RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON J,L,CNT(27),BT,MK,SUB,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,INSNUM,NNUM,JJ,JA,ISUB,NFLG,
1 IXX,ISEMI,IQT
1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
1,TEDIT/20H(' RETYPE LINE?'/ )/,IEN/'N'/,ITMPO/'TEMPO'/
C *************** READS INPUT ***********************
ERRFLG=0
KIMIT=LIMIT-100
C FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
ICHD=0
2308 IF(ITYP)GO TO 2127
23081 TYPE TINST
ACCEPT 77732,JNP
IF(JNP(1).EQ.' ')GO TO 23081
CHECK FOR TAB
77732 FORMAT(80A1)
CC IF(JED)WRITE(21,77732)INP
IF(JED)CALL COLTTY(JNP,21)
JFM(4)='80A1)'
C PUTS ON LPT AND TTY
GO TO 1074
CC 6/74 COLGATE2127 JREAD=1
CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
2127 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
441 JFM(4)='80A1)'
CC IF(IFI.GE.0)GO TO 1074
IF(LN.EQ.0)GO TO 1074
CC REREAD 2114,LN,JNP
C**** READS FILES WITH OR WITHOUT LINE NUMBERS! **** NOT AT STANFORD
CC IF(JNP(1).EQ.' ')GO TO 2308
CHECK FOR TAB ***** DOESN'T DO WITH SOS FILES ******
JFM(1)=' (I,A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,LN,J,JNP
GO TO 4127
1074 IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 2308
C ABOVE FOR COMMENTS DOESN'T CATCH THIS WITH SOS FILES↑V↑V↑V↑V↑V↑V↑V↑V↑V↑V↑V↑V
C BIG NUM = '<'
IF(INP1.EQ.' ')GO TO 2308
CHECK FOR TAB
JFM(1)=' (A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,J,JNP
4127 IF(JED)GO TO 41271
IF(K.EQ.'Y')GO TO 41271
C K CHECK IS TO PASS AFTER RETYPING
TYPE TEDIT
ACCEPT 77732,K
CALL LO2UP(K)
IF(K.EQ.'Y')GO TO 23081
IF(K.EQ.IG)JED=-1
41271 IF(J.EQ.IBLA)GO TO 2308
CHECKS FOR SPACE(IBLA)
CALL LO2UP(J)
C MAKE SURE INST NAME, ETC. IS UPPER CASE.
LLETRS=MLX
C LETRS FOR NAME CHANGE FEATURE AT 104
MLX=1
IZ=0
JA=-1
ISUB=4
CALL CLEAN(LEND)
C CLEANS OUT = AND , AND FINDS LINE LENGTH.
ALL=1.
VX1=0
VX2=0
VX3=0
INSNUM=-1
K=0
JRSTA=0
IOFSET=0
C** IOFSET IS FOR 'CONTINUATION PARAMETERS' - SO INPUT P'S MATCH INST.
C** CAUTION!!! ANY 'OFFSET' PARAMS THAT ARE REFERRED TO AFTER AN 'END'
C** MUST USE THE PROPER INTERNAL NUMB. OF SCORE, NOT THE INST. PARAM!!!!!
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,LEND
N=INP(JD)
IF(N.NE.'R')GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,LEND
KL=INP(M)
IF(KL.EQ.IBLA)GO TO 3631
IF(KL.EQ.ISEMI)GO TO 3631
CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
JRSTA=J
GO TO 362
363 CONTINUE
361 IF(N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J)GO TO 6773
IF(IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
INSNUM=K
GO TO 1773
36 IF(J.EQ.'RUN;')GO TO 197
IF(J.NE.'RUN')GO TO 97
197 CALL RUNIT
97 IF(J.EQ.'INSER')GO TO 397
IF(J.EQ.'PRECE')GO TO 397
IF(J.NE.'EDIT')GO TO 297
397 ISUB=6
297 IF(ISUB.GT.4)GO TO 1773
IF(J.EQ.ITMPO)GO TO 1773
IF(J.EQ.'CONDU')GO TO 1773
IF(J.EQ.'PLAY')GO TO 1773
IF(J.EQ.'SECTI')GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.'END')GO TO 1082
IF(J.EQ.'END S')GO TO 1082
IF(J.EQ.'FINIS')GO TO 1082
362 INSNUM=NINS+1
IF(INSNUM.GT.KZY)CALL ERR(7)
INST(INSNUM)=J
LETRS(INSNUM)=LLETRS
C SAVE HOW MANY LETTERS IN INST. NAME (FOR 'RUNIT')
IZ=INSNUM
GO TO 1773
C*********** DOWN TO 8001 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
C****** OR 80 ↑↑↑↑↑↑↑↑↑ ?????
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
8001 FORMAT(A5,5F)
107 FORMAT(I,A5,5F)
4 IF(INSNUM.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(INSNUM)=VX1
IDALL=INSNUM
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(INSNUM)=VX1
IF(INSNUM.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=INSNUM
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(INSNUM)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.EQ.0)GO TO 900
C 2 NUMBS HERE MEAN START ON NOTE NUM.VX2 OF INST.VX1
IF(VX1.EQ.0)VX1=INSNUM
C VX1=0 MEANS USE NUMB. OF THIS INST.
VX1=VX1*10000.+VX2
900 IF(VX1.NE.BY)GO TO 497
IF(J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
497 BY=VX1
C BY=CURRENT BG TIME.
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(JRSTA.EQ.0)GO TO 3173
DO 173 K=NINS-1,1,-1
173 IF(JRSTA.EQ.INST(K))GO TO 1173
1173 VX1=K
GO TO 7720
C GO DO A 'DUPL'
2173 JRSTA=0
3173 IF(J.EQ.ITMPO)GO TO 1106
IF(J.EQ.'CONDU')GO TO 3018
IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
CZZZZZZZ MLX=ML
ML=MLX
IF(I.LT.KIMIT)GO TO 774
TYPE 107,I
IF(I.GE.LIMIT)TYPE 1774
1774 FORMAT(/' ******* TOO MUCH INPUT DATA!! USE "MIXSCR" *******'/)
774 ALL=1.
SUB=0
ISUB=1
CXXX IF(MLX.LT.LEND)GO TO 17732
CXXX THIS LOST ON );Px . . . ; TAKEN OUT 8/20/76
CXXX GO TO 7773
CZZZZZZZZZZZZZZZZZZZZZZZZ
1299 IF(MLX.LE.LEND)GO TO 1773
CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
7773 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
CQQQ IF(INP1.EQ.IBLA)GO TO 7773
IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 7773
C ABOVE FOR COMMENTS. BIG NUM = '<'
IF(JED)GO TO 77733
TYPE TEDIT
ACCEPT 77732,K
CALL LO2UP(K)
IF(K.NE.'Y')GO TO 442
TYPE TPALN
ACCEPT 77732,JNP
442 IF(K.EQ.IG)JED=-1
C DOESN'T WORK FOR EDITS AND INSERTS YET???
77733 MLX=1
C FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
CALL CLEAN(LEND)
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(QTS.GE.0)GO TO 597
IF(V(I-1).EQ.999.)L=L-1
597 IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
CC17732 JZ=0
17732 N=0
17731 ML=MLX
C BIG LOOP -- TO END OF PAGE 1.
JPP=-1
C FOR OLD 'DF' STUFF. CHECKS FOR A Pn
JD=ML
975 N=INP(JD)
IF(N.EQ.IBLA)GO TO 236
IF(N.EQ.IPP)JPP=0
C FOUND 'P'
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.EQ.'(')GO TO 697
IF(N.NE.')')GO TO 2361
IF(MOT.NE.0)GO TO 697
IF(PARENS.NE.0)GO TO 697
CALL ERR(5)
C FATAL ERROR - RT PARENS WITH NO EARLIER LFT PARENS.
STOP
697 INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.')')GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)CALL ERR(3)
MOT=LCNT-1
1140 DO 11401 JC=1,LCNT-1,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
TYPE 11402,INP(L)
CC CALL EXIT
11402 FORMAT(' ****** MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
C ''''''' FOR SINGLE QUOTES
3361 IPRN=IPRN+1
GO TO 236
C JUMPS BACK INTO QUOTE SECTION
CQ IF(PARENS.EQ.0)GO TO 2140
CQ LIST(LCNT+2)=L
CQ LCNT=LCNT+3
CQ PARENS=0
CQ GO TO 33612
CQ2140 LIST(MOT)=L
CQ GO TO 33612
CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(N.NE.':')GO TO 2362
ICHD=ICHD+1
N=KSLA
GO TO 336
2362 IF(N.NE.'@')GO TO 5361
DO 113 L=1,LEND
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.'-')GO TO 6113
IF(CODE.EQ.-88.)CALL ERR(8)
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.'$')GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
IF(CODE.EQ.-88.)CALL ERR(8)
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 JMOT=1,LCNT,3
IF(JG.NE.LIST(JMOT))GO TO 6361
VX1=0
DO 40 M=JD+2,LEND
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
IF(JG.EQ.KSLA)GO TO 140
IF(JG.EQ.ISEMI)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(JMOT+1)
M=LIST(JMOT+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
C INVERSIONS NEXT
840 X=V(KN)
IF(X.GT.-9999.)GO TO 841
C CAN'T INVERT A 'P' NUMBER.
Z=X
GO TO 941
841 RB=X
X=ABS(X)+VX1
Z=X
IF(RB)Z=-Z
941 V(I)=Z
CC V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
KN=KN+JC
IF(V(KN-JC).NE.199.)GO TO 940
C 199. IS NOW NUM. FOR 'R' (REST) 7/78
V(I-1)=199.
GO TO 840
940 Z=V(KN)
IF(Z.LT.-9999.)GO TO 540
C CAN'T INVERT OR TRANSPOSE 'P' NUMBERS.
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.(NO LIT)
IF(CODE.EQ.-88.)CALL ERR(8)
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.199.)GO TO 540
C 199. IS NOW NUM. FOR 'R' (REST) 7/78
Y=0
RB=VX1
IF(Z)RB=-RB
IF(INVRT)GO TO 541
RB=-RB
RC=X
C X IS SET FURTHER BACK.
IF(Z)RC=-RC
C THIS STUFF FOR CHORD FEATURE
Y=(RC-Z)*2
541 Z=Z+RB+Y
Y=ABS(Z)
IF(Y.LT.1.OR.Y.GT.108)CALL ERR(8)
C ERROR IF TRANSP. HAS PUSHED A NOTE NUMBER TOO HIGH OR TOO LOW.
V(I)=Z
CC IF(INVRT.EQ.0)Y=(X-Z)*2.
CC V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 IF(JC.GT.0)GO TO 543
IF(CODE.NE.-33)GO TO 543
JG=I
IF(V(I).GT.0)GO TO 543
542 Y=V(JG)
V(JG)=V(JG-1)
V(JG-1)=Y
C THIS STUFF FOR CHORD FEATURE
IF(V(JG-2).GT.0)GO TO 543
JG=JG-1
GO TO 542
543 I=I+1
IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
DO 8361 L=JD,LEND
JG=INP(L)
C PUT IN NOV 25, 72
CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
KN=L
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.')')IPRN=IPRN+1
IF(JG.NE.ISEMI)GO TO 8361
IAMP=-1
GO TO 9361
8361 CONTINUE
C ABOVE 4 LINES PUT IN 8/76. REPLACE C*********** ↑A↑A
9361 MLX=L+1
IF(L.GE.LEND)GO TO 93612
C************9361 MLX=L
C************ IF(L.EQ.LEND)GO TO 93612
C ↑↑↑↑↑↑↑ 6/75
C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
IF(IAMP.NE.0)GO TO 797
IF(QTS)GO TO 1773
C GO BACK IF NOT END OF LINE
797 JZ=-1
93612 IF(IAMP.EQ.0)GO TO 93611
C NOV 25, 72
C*** JUNE 78 *** BELOW GOES TO CHECK ON INTERNAL TEMPO *****IF(QTS)GO TO 3013
IF(QTS)GO TO 9004
GO TO 2722
C THESE ARE FOR "LIT" ITEMS
C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
93611 IF(KN.EQ.LEND)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
GO TO 236
C LAST TIME FOR QUOTES
C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
C JUMPS TO END STRING OF QUOTES
6361 CONTINUE
CALL ERR(0)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.EQ.'$')CALL ERR(8)
C FOUND $ BUT NO @!
INPX=INP(JD+1)
CC IF(N.NE.ID)GO TO 53611
CC IF(ISUB.NE.1)GO TO 53611
CC IF(INPX.NE.IF)GO TO 236
C JUMP IF NOT DUTY FACTOR
CC IF(JPP)GO TO 236
C JUMP IF 'P' HAS NOT BEEN SEEN.
CC SUB=SUB-100.
CC GO TO 43615
53611 IF(N.NE.ISS)GO TO 53612
IF(INPX.NE.'U')GO TO 53612
SUB=SUB-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.'M')GO TO 612
IF(INPX.NE.'I')GO TO 612
SUB=SUB-200.5
C THE '.5' CALLS 'MICRO' RATHER THAN 'SUBR'.
GO TO 43615
612 IF(N.NE.IAA)GO TO 43611
C FINDS 'ALL'.
IF(INPX.NE.'L')GO TO 236
ALL=-1.
GO TO 43615
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
C BEFORE! QUAD (IF USED).
C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611 IF(N.NE.'Q')GO TO 4361
CCC IF(INPX.NE.'U')GO TO 4361
C REMOVE QUAD FEATURE FROM OTHER SITES*******************10/80******
GO TO 4361
QX=-13.
DO 43612 N=JD,LEND
J=INP(N)
IF(J.EQ.IXX)QX=QX-1.
IF(J.EQ.IF)QX=QX-2.
IF(J.EQ.IBLA)GO TO 236
IF(J.EQ.KSLA)GO TO 236
CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612 INP(N)=IBLA
4361 IF(N.NE.'I')GO TO 43613
IF(ISUB.NE.4)GO TO 43613
C -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C -3= BOTH BEGINNING AND END ARE INVIS.
C THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
L=-1
CSS N=INP(JD+1)
CSS IF(N.EQ.IE)L=L-1
IF(INPX.EQ.IE)L=L-1
INVIS(INSNUM)=INVIS(INSNUM)+L
43615 DO 43614 L=JD,LEND
N=INP(L)
CC IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
IF(N.EQ.IBLA)GO TO 236
IF(N.EQ.ISEMI)GO TO 236
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614 INP(L)=IBLA
CC43613 IF(N.NE.KSLA)GO TO 636
43613 IF(N.NE.KSLA)GO TO 1336
CC JZ=-1
IF(JD.GE.LEND-1)JZ=0
C SO IT WILL READ NEXT LINE.
CZZZZZZZZZZZZZZZ INP(JD)=ISEMI
GO TO 336
CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
CCZZZ MLX=MLX+1
CCZZZ GO TO 436
CC636 IF(JD.LT.LEND)GO TO 1336
CC ICON=0
CC GO TO 77731
CC GO TO 7773
C TO CONTINUE ON NEXT LINE.
CCZZZ636 IF(N.NE.ISEMI)GO TO 936
1336 IF(N.NE.ISEMI)GO TO 936
IAMP=-1
CC IF(ISUB.NE.1)IAMP=-1
336 MLX=JD+1
IF(ISUB.GE.104)GO TO 104
IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
CCZZZ936 IF(N.NE.IDOT)GO TO 736
936 IF(N.NE.IDOT)GO TO 136
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22..OR.CODE.EQ.-23.)INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
CCZZZ736 IF(N.NE.'*')GO TO 136
CCZZZ IAMP=-1
CCZZZ INP(JD)=IBLA
CCZZZ GO TO 336
136 IF(N.NE.IQT)GO TO 236
DO 1361 K=JD+1,LEND
IF(INP(K).NE.IQT)GO TO 1361
JD=K+1
GO TO 975
C SKIPS MATERIAL IN QUOTES
1361 CONTINUE
CALL ERR(0)
C OPEN QUOTES
236 JD=JD+1
IF(JD.LE.LEND)GO TO 975
CALL ERR(1)
1899 CALL SCANR
CZZZZZZZ ML=MLX
CZZZZZZZZZZZZZZZZZZZZZZZZZZ
GO TO(1,2,3,4,5,6),ISUB